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جامعة ٠‏ مشه 


كلية الهندسة المعلوماتية 


مدة الامتحان: ساعتان 


حل امتحان مقرر برمجة 2 - السنة الأولى - الفصل الثاني 2009 


السؤال الأول: (25 درجة) لدينا البرنامج التالي: 


program Example(output); 
type rptr=^recdata; 
recdata=record 
number:integer; 
end; 

var startrecord:rptr; 

begin 

new(startrecord); 

if startrecord=nil then 

begin 

writeln(' 1 :unable to allocate storage space'); exit; 
end; 

startrecord^.number:=10; 
startrecord^.code:='LOLO'; 
new(startrecord^.nextrecord); 

if startrecord^.nextrecord= nil then 

begin 

writeln('2: unable to allocate storage space'); exit; 
end; 

startrecord^.nextrecord^.number:=15; 
startrecord^.nextrecord^.code:='SOSO'; 
new(startrecord^.nextrecord^.nextrecord); 

if startrecord^.nextrecord^.nextrecord=nil then 
begin 

writeln('3: unable to allocate storage space'); 
end; 
startrecord^.nextrecord^.nextrecord^.number:=5; 
startrecord^.nextrecord^.nextrecord^.code:='"'TOTO'; 
startrecord^.nextrecord^.nextrecord^.nextrecord:=nil; 
writeln(startrecord^.nextrecord^.number); 
writeln(startrecord^.nextrecord^.code); 
writeln(startrecord^.number); 
writeln(startrecord^.code); 
writeln(startrecord^.nextrecord^.nextrecord^.number); 
writeln(startrecord^.nextrecord^.nextrecord^.code); 
end. 


code: string; nextrecord:rptr; 


exit; 


المطلوب: 
1. حدد خرج البرنامج السابق. (5) 
2. ارسم اللائحة المشكلة مبينا محتوى عناصرها. 
3. اكتب وحدة برمجية (۸۸) تتضمن الإجرائيات التالية: 
ه. إجراء لحذف العنصر الأول من اللائحة السابقة. 
ا. إجراء لحذف العنصر الأخير من اللائحة السابقة. (3) 
ع. إجراء البحث عن عنصر ضمن اللائحة السابقة. (3) 
4. عدل البرنامج السابق ليصبح بإمكانه استخدام الوحدة (۸۸). (2) 
5. أضف ثلاث تعليمات مناسبة إلى نهاية البرنامج السابق لإلغاء جميع 
عناصر اللائحة » دون استخدام مؤشرات مساعدة أو حلقة. (3) 


(3) 
(3) 


2 المهندس خالد ياسين الشيخ 


السؤال الثانى:(10 درجات) لدينا البرنامج التالي: 


program TEST (output); 
type time=RECORD 

hours, minutes, seconds: integer; 

END; 

Procedure timeupdate(var newtime:time); 
begin 
newtime.seconds:=newtime.seconds+1; 
if newtime.seconds=60 then 
begin 
newtime.seconds:=0; 
newtime.minutes:=newtime.minutes+1; 
if newtime.minutes=60 then 
begin 
newtime.minutes:=0; 
newtime.hours:=newtime.hours+1; 
if newtime.hours=O0 then 
newtime.hours:=0; 
end; 
end; 
end; 


var test_times: array[1..3] of time; 
loop :integer; 
begin 
test_times[1].hours:=11; 
test_times[1].minutes:=59; 
test_times[1].seconds:=59; 
test_times[2].hours:=12; 
test_times[2].minutes:=0; 
test_times[2].seconds:=0; 
test_times[3].hours:=1; 
test_times[3].minutes:=29; 
test_times[3].seconds:=59; 
for loop:= 1 to 3 do 
begin 
writeln('Time is',test_times[loop].hours,':', 
test_times[loop].minutes,':',test_times[loop].seconds); 
timeupdate(test_times[loop]); 
writeln(test_times[loop].hours,':', 
test_times[loop].minutes,':',test_times[loop].seconds); 
end; 
readin; 


(اللهم صلي وسلم على سيدنا محمد و على آله وصحبه أجمعين) 
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الحل: 
خرج البرنامج هو: 
15 
SOSO‏ 
10 
LOLO‏ 
5 
TOTO‏ 
الحقول التالية: 
number | code nextrecord‏ 
حيث 4إهءه٤»×هم‏ هو عبارة عن مؤشر للعنصر التالي في السلسلة. 
startrecord‏ 
LOLO jnextrecord‏ 
SOSO nextrecord‏ 
نكتب الوحدة ۸۸ كما يلي: 
unit AA;‏ 
interface‏ 
type‏ 


rptr=^recdat; 

recdat=record 

number:integer; 

code:string; 

nextrecord:rptr; 

end; 

procedure delfirst(var startrecord:rptr); 
procedure delast(var head:rptr); 

function search(head:rptr;v:integer):boolean; 


: المهندس خالد ياسين الشيخ 


end. 
المطلوب:‎ 
مستعينا بالرسم بين بنية و محتوى المصفوفة وم٣ [_اءه] بعد‎ .۲ 
)5( . تنفيذ البرنامج‎ 


الحل : 
خرج البرنامج هو : 


Time is11:59:59 
12:0:0 
Time is12:0:0 
12:0:1 
Time is1:29:59 
1:30:0 
المصفوفة وم آ†_ءه] عبارة عن ثلاث خانات(ثلاث أدلة) كل خانة‎ 
أو دليل يحوي بنية المعطيات التالية:‎ 
hours 


minutes | seconds 


الدلیل ×علہا 


و تكون محتوى المصفوفة بعد تنفيذ البرنامج كالتالي: 


الدلیل رقم ۲ 
ج 


20/1 1300 


ا الدليل رقم ١‏ 


12 0 


test_times 


(اللهم صلي وسلم على سيدنا محمد و على آله وصحبه أجمعين) 


کم خلا لائ 


implementation 

procedure delfirst(var startrecord:rptr); 
var p:rptr; 

begin 

p:=startrecord; 
startrecord:=startrecord^.nextrecord; 
dispose(p); 

end; 

procedure delast(var head:rptr); 
var p1,Pp2,p:rptr; 

begin 

p:=head;p1:=p; 
while(p^.nextrecord<>nil)do 
begin 

p1:=p; 

p:=p^.nextrecord; 

end; 

if(p<>nil)then 

begin 
p1^.nextrecord:=p^.nextrecord; 
dispose(p); 

end; 

end; 

function search(head:rptr;v:integer):boolean; 
begin 

while(head<>nil)do 

begin 

if(head^.number=v)then 

begin 

search:=true; 

break; 

end; 

head:=head^.nextrecord; 
search:=false; 

end; 


end; 


end. 
يصبح البرنامج باستطاعته استخدام الوحدة ۸۸ كما يلي:‎ 
Program Example(output); 
uses AA; 
Var startrecord:rptr; 
procedure print(p:rptr); .ةذuuلl إجراء لطباعة عناصر‎ 
begin 
while(p<>nil)do 
begin 
writeln(p^.number,' ',p^.code); 
p:=p^.nextrecord; 
end; 
end; 
begin 


4 المهندس خالد ياسين الشيخ 


حل لی ق٣‏ 
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السؤال السادس:(20 درجة) لدينا: 


اكتب برنامج بلغة باسكال القياسية يقوم بقراءة ملفين نصيين و يعرضهما على 
شاشة الحاسب على النحو المبين أدناه٠‏ 


The first line of file 1 The first line file 2 


The second line of file 1 line 2 of file 2 
Another line of file 1 line 3 of file 2 
This is a long line fro>>> the end file 2 


Another line from file 1 


etc 
مع مراعاة النقاط التالية:‎ 


٠‏ يطبع سطر الملف الأول تم يليه سطر الملف الثاني بعد خمسة فراغات. 

ه في حال تجاوز طول سطر الملف عن 30 محرف يتم إهمال الأحرف 
التالية للمحرف 30 و يضاف إلى السطر المحارف 
التلاث التالية <<< للإشارة إلى ذلك. 

ه في حال انتهاء ملف قبل الآخر » يتم الاستعاضة عن كل سطر من أسطر 
الملف المنتهي بمجموعة من الفراغات 


program tests 

var f1,f2:texts 

c:char; 1,cl1:shortint; 
begin 
assign(f1,'c:\f1.txt'); 
assign(f2,'c:\f2.txt'); 
reset(f1); 

reset(f2); 

while(not eof(f1) or(not eof(f2)))do 
begin 

1:=0;  c1:=0; 
while(not eoln(f1))do 
begin 

read(f1,c); 

1i=1+1; 

if(i>30)then 

begin 

write(>>>'); 

break; 

end; 

write(c); 

c1:=c1+1; 

end; 

if(i>30)then 


(اللهم صلي وسلم على سيدنا محمد و على آله وصحبه أجمعين) 


کم خلك لائ 


new(startrecord); 
if startrecord = nil then 
begin 
writeln('1: unable to allocate storage space'); exit; 
end; 
startrecord^.number:=10; 
startrecord^.code:='LOLO'; 
new(startrecord^.nextrecord); 
if startrecord^.nextrecord=nil then 
begin 
writeln('2: unable to allocate storage space'); exit; 
end; 
startrecord^.nextrecord^.number:=15; 
startrecord^.nextrecord^.code:='SOSO'; 
new(startrecord^.nextrecord^.nextrecord); 
if startrecord^.nextrecord^.nextrecord = nil then 
begin 
writeln('3: unable to allocate storage space'); exit; 
end; 
startrecord^.nextrecord^.nextrecord^.number:=5; 
startrecord^.nextrecord^.nextrecord^.code:='TOTO'; 
startrecord^.nextrecord^.nextrecord^.nextrecord:=nil; 
writeln(startrecord^.nextrecord^.number); 
writeln(startrecord^.nextrecord^.code); 
writeln(startrecord^.number); writeln(startrecord^.code); 
writeln(startrecord^.nextrecord^.nextrecord^.number); 
writeln(startrecord^.nextrecord^.nextrecord^.code); 
writeln ('-------- 3 
delfirst(startrecord); 
delast(startrecord); 
print(startrecord); 
if(search(startrecord,15))then 
writeln('found') 
else 
writeln('not found'); 
readin; 
end. 

التعليمات الثلاث التي نضيفها إلى البرنامج المكتوب في نص السؤال لإلغاء 


1- dispose(startrecord^.nextrecord^.nextrecord); 
2- dispose(startrecord^.nextrecord); 
3- dispose(startrecord); 

startrecord:=nil; 


السوال الثالث٠‏ )5 درجات) حدد خرج البرنامج التالي مع التعليل (یمکن 


5 المهندس خالد ياسين الشيخ 


حل لج ق٣‏ 


ناتج لتنفيذ البرنامج: 


khaled yassin 

hi 

hi 

syria 

welcone welcon syria khaled kh??? 
we lcone welcon syria khaled kh??? 
we lcone welcon syria khaled kh??? 


khaledyassinkh @gmail.com 


begin 

for 1:=1 to 5 do 
write( '); 

end 

else 

for 1:=c1 to 37 do 
write( "); 

1:=0; 

c1:=0; 

while(not eoln(f2))do 
begin 

read(f2,c); 

1:=1+1; 

c1:=c1+1; 
if(i>30)then 

begin 

write(>>>'); 
break; 

end; 

write(c); 

end; 
readln(f1);readIn(f2); 
writeln; 

end; 
close(f1);close(f2); 
readln; 

end. 


ye Icone to syria khaled we lcon??? 


(اللهم صلي وسلم على سيدنا محمد و على آله وصحبه أجمعين) 


ال م خلك لا حل لج ة۲ 


استخدام الرسم للتعليل). 
program pointers(output);‏ 
type int_pointer=^.integer;‏ 
var iptr1, iptr2:int_pointer;‏ 
begin‏ 
new(iptr1); new(iptr2);‏ 
iptr1^:=10; iptr2^:=25;‏ 
writeln('the value of iptr1 is ',iptr1);‏ 
writeln('the value of iptr2 is ',iptr2);‏ 
dispose(iptr1);‏ 
iptr1:=ipt2; iptr1^:=3;‏ 
writeln('the value of iptr1 is ',iptr1);‏ 
writeln('the value of iptr2 is ',iptr2);‏ 
dispose(iptr2);‏ 
end.‏ 

الحل: 


التعلیمتان w)1p۲1(‏ ع" و (۲2م|i)‏ سم تقومان بجعل المؤشران ۲1م| و 
2م¡ يؤشران إلى بنية معطيات و هي عبارة عن قيمة من نمط صحيح و 
بلغة أدق تجعل المتحول 1۲1م¡ يؤشر إلى عنوان في الذاكرة يحوي قيمة من 
نمط صحيح و كذلك الأمر بالنسبة للمتحول ۲2م¡ 

و التعليمة 1۲17:=10م¡ تضع القيمة 10 في محتوى العنوان الذي يحويه 
المؤشر ۲1ص و كذلك الأمر للمؤشر 1۲2م¡ حيث نضع القيمة 25. 

و عند تنفيذ التعليمة (1٣م|)عءه0مءال‏ فإنها تقوم بحذف محتويات ٨۲1م¡‏ 
أي تم حذف القيمة 10. 

و التعليمة 1۲2م1۲1=1م¡ تجعل المتحول ۲1م¡ يؤشر إلى نفس عنوان 
2م¡ في الذاكرة(كلا المتحولين يحويان العنوان نفسه في الذاكرة) 

و التعليمة ۲17:=3م¡ تجعل محتوى العنوان الذي يؤشر إليه المتحولين 
1م| و ۲2ط¡ يحويان نفس القيمة في الذاكرة وهي 3. 

و يمكن توضيح ذلك من خلال الرسم البيائي كالتالي: 


ا 


lptr1 


lptr1 


EE 


Iptr1 Iptr2 


Iptr1 Iptr2 


lptr2 
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6 المهندس خالد ياسين الشيخ (اللهم صلي وسلم على سيدنا محمد و على آله وصحبه أجمعين) 


الم خلك لا حل لج ة٣‏ 


Dea 


lptr1 Iptr2 


the value of iptr1 is10 
the value of iptr2 is25 
the value of iptr1 is3 
the value of iptr2 is3 


السؤال الرابع:(5 درجات) لدينا: 

Type 

Day=(Monday,Tuesday, Wednesday, Thursday, Friday, 
Saturday, Sunday); 


Var Today:Day; 
ما الخطأ فى التعليمات التالية-‎ 


for Today:=Sunday to Monday do 
begin 
writeln(Today); 
Today:=succ(Today); 
end; 
الحل:‎ 
لا سمح‎ tu حیث مترجم ای۴ 0ط‎ سا٤‎ ع۱٣)٣‎ ٥ھ‎ y( الخطاً في التعلیمة‎ 
بقراءة و طباعة القيم العددية من هذا النوع مباشرة.‎ 
for Today:=Sunday to Monday do هناك خطأً منطقي في التعليمة‎ 
و ۷=6هلمںك حسب الترتيب و بالتالي لن یتم‎ N0 "لay=0 حيث نعلم أن‎ 
تنفيذ محتوى تعليمات الكتلة التابعة لحلقة ٣ه يجب تعديل التعليمة و بعد‎ 
التعديل يجب حذف التعليمة (yھ له ٣)ءءںء=رھ هه إذا أردنا طباعة ترتيب‎ 
أيام الأسبوع العددية علما أنها مقبولة و لا يوجد بها خطأ لغوي و لكن فقط‎ 
نزيل هذه التعليمة لطباعة القيم العددية للأيام بدءا مثلا من رمك نك و‎ 
٠لكشلا یصبح البرنامج السابق غل‎ 
Type 
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7 المهندس خالد ياسين الشيخ (اللهم صلي وسلم على سيدنا محمد و على آله وصحبه أجمعين) 


الم خلك لا حل لج ة۲ 


Day=(Monday,Tuesday, Wednesday, Thursday, Friday, 
Saturday, Sunday); 
Var Today:Day; 
Begin 
For Today:=Sunday downto Monday do 
Writeln(ord(today)); 
Readln; 
End. 
الخرج :بعد تعديل البرنامج هو:‎ 


O لہ م‎ wv ہی ھج‎ Wa 


السؤال الخامس:(5 درجات) ما الخطاً فى التعليمات التالية : 
type Gradepoints = 0.0 .. 4.0;‏ 

Number= integer; 
Alphabet= 'Z'..'A'; 

الحل : 

- التعليمة 4.0 .. 0.0=ء†"iممعمdهإü‏ خاطئة و الصحيح هو: 

Gradepoints=0 .. 4; 

- التعليمة Number= İin†ِge ٣;‏ صحیحة. 

- التعليمة ٥۲='7'..'^';‏ ما۸ خاطئة و الصحيح هو: 


Alphabet='A'..'Z'; 
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8 المهندس خالد ياسين الشيخ (اللهم صلي وسلم على سيدنا محمد و على آله وصحبه أجمعين) 


,کم خلك لائ 


khaledyassinkh @gmail.com الہ ةا‎ 


اكتب برنامج بلغة باسكال يقوم بطباعة أسطر ملف نصي »۴1.1 ذات الترتيب الزوجي على الشاشة. 


مثال لدينا ملف ».۴1 يحوي ما يلي: 


Khaled yassin 
Welcome to syria 
Khaled yassin information 


Damascus in syria Arabic 


يتم طباعة على الشاشة الأسطر ذات الترتيب الزوجي فقط كما يلي: 


ناتج تنفيذ البرنامج: 


lle lcome to syria 


Danascus in syria Arabic 


المهندس خالد ياسين الشيخ 


Welcome to syria 


Damascus in syria Arabic 


program test; 

var f1:text; 

c:char; i:integer; 
begin 
assign(f1,'c:\f1.txt'); 
reset(f1); 

1= 

while(not eof(f1))do 
begin 

while(not eoln(f1))do 
begin 

if(i mod 2=1)then 
begin 

readln(f1); 

break; 

end; 

read(f1,c); 

write(c); 

end; 

if i mod 2=0 then 
begin 

readln(f1); writeln; 
end; 

i:=i+1; 

end; 

close(f1); 

readln; 

end. 


(اللهم صلي وسلم على سيدنا محمد و على آله وصحبه أجمعين) 
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,کم خلا لائ 


khaledyassinkh @gmail.com ٣ة علا ل‎ 


اكتب برنامج بلغة باسكال يقوم بإعادة تشكيل ملف نصي »]. بعد حذف الأسطر ذات الترتيب الفردي. 


ليكن محتوى الملف 1×ع.] كالتالي: 


يصبح بعد تنفيذ البرنامج كالتالي: 


المهندس خالد ياسين الشيخ 


Khaled yassin from syria Arabic 
Welcome to syria 

Service information 

Syria Arabic 

Good luck 


Welcome to syria 
Syria Arabic 


program test; 

var f1,f2:text; 
c:char; i:integer; 
procedure movef1tof2; 
begin 
assign(f1,'c:\t.txt'); 
assign(f2,'c:\f2.txt'); 
reset(f1); 

rewrite (f2); 

i:=1; 

while(not eof(f1))do 
begin 

while(not eoln(f1))do 
begin 

if(i mod 2=1)then 
begin 

readln(f1); 

break; 

end; 

read(f1,c); 
write(f2,c); 

end; 

if i mod 2=0 then 
begin 

readln(f1); 
writeln(f2); 

end; 

i:=i+1; 


end; 
close(f1); 


(اللهم صلي وسلم على سيدنا محمد و على آله وصحبه أجمعين) 
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,کم خلك لائ 


khaledyassinkh @gmail.com ٣ة علا ل‎ 
close(f2); 

end; 

procedure movef2tof1; 
begin 
assign(f1,'c:\t.txt'); 
assign(f2,'c:\f2.txt'); 
reset(f2); 

rewrite (f1); 
while(not eof(f2))do 
begin 

while(not eoln(f2))do 
begin 

read(f2,c); 
write(f1,C); 

end; 

readln(f2); 
writeln(f1); 

end; 

close(f1); 

close(f2); 

end; 

begin 

movef1tof2; 
movef2tof1; 

readin; 

end. 


اكتب برنامج بلغة باسكال القياسية يقوم بطباعة عناصر سلسلة خطية وحيدة الاتجاه بشكل معكوس في ملف نصي أ×. 
مع مراعاة حذف العنصر المنقول علما أن عنصر السلسلة يحوي حقل واحد للمعطيات و هو القيمة ۷ من نمط صحيح. 


مثال: 
عنصر السلسلة له الحقول التالية. 


next 


(#ععV)int ٠‏ و يمكن لنا تخيل السلسلة وحيدة الاتجاه كما في 


الرسم البياني التالي:فمتلا من أجل سلسلة حجمها ۳ عناصر محتواها كالتالي: 


يتم بعد تنفيذ البرنامج نقل عناصر السلسلة إلى الملف ا×).† بشكل معكوس فيصبح محتواها كالتالي: 


تكتب إجرائية م۷٠٥‏ تقوم بالمطلوب كالتالي: 


المهندس خالد ياسين الشيخ 


ىہ 


procedure move(var p:pointer); 

var f:text; i,j:integer; temp:pointer; 
a:array[1..300] of integer; 

begin 

assign(f,'c:\t.txt'); 

rewrite (f); 

i:=1; 


(اللهم صلي وسلم على سيدنا محمد و على آله وصحبه أجمعين) 
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کم خلك لائ 


khaledyassinkh @gmail.com ٣ة علا ل‎ 
temp:=p; 

while(p<>nil)do 

begin 

a[i]:=p^.v; 

temp:=p; 


p:=p^.next; 
dispose(temp); 

i:=i+1; 

end; 

for j:=i-1 downto 1 do 
writeln(f,a[j]); 
close(f); 

end; 


اكتب برنامج بلغة اهعوج۴ طن يقوم بحذف الأسطر الحاوية على كلمة اط في ملف نصي ».۴ 


مثال ليكن محتوى الملف النصي ».۴ كالتالي: 


يصبح محتوى الملف ».۴ بعد تنفيذ البرنامج كالتالي: 
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hi omar how are you 
Syria Arabic 

I' m From syria 

hi khaled hi omar 

hi 


Syria Arabic 
I'm From syria 


program test; 

var f1,f2:text; 
c:char; s:string; g:set of 1.. 255; i:integer; 
ok:boolean; 
procedure mm; 
begin 

ok:=false; 

8:=[]; 

i:=1; 
assign(f1,'c:\t.txt'); 
reset(f1); 

while(not eof(f1))do 
begin 

a 

ok:=false; 

while(not eoln(f1))do 
begin 

read(f1,c); 

if(c<>' ')Jthen 
S:i=sS+C; 

if(s='hi')then 

begin 

ok:=true; 

readln(f1); 

g:=g+[i]; 

break; 
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end; 
if(c=' ')then 


$:=", 


end; 

if( not ok)then 
begin 

if s='hi'then g:=g+[i]; 
readln(f1); 

end; 

i:=i+1; 

end; 

close(f1); 

end; 

procedure movef1tof2; 
begin 

ok:=false; 
assign(f1,'c:\t.txt'); 
assign(f2,'c:\f2.txt'); 
reset(f1); 

rewrite (f2); 

i:=1; 

while(not eof(f1))do 
begin 

ok:=false; 

while(not eoln(f1))do 
begin 

if(i in g)then 

begin 

ok:=true; 

readln(f1); 

break; 

end; 

read(f1,c); 
write(f2,c); 

end; 

if (not ok) then 
begin 

readln(f1); 
writeln(f2); 

end; 

i:=i+1; 


end; 

close(f1); 

close(f2); 

end; 

procedure movef2tof1; 
begin 
assign(f1,'c:\t.txt'); 
assign(f2,'c:\f2.txt'); 
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reset(f2); 
rewrite (f1); 
while(not eof(f2))do 
begin 
while(not eoln(f2))do 
begin 
read(f2,c); 
write(f1,C); 
end; 
readln(f2); 
writeln(f1); 
end; 
close(f1); 
close(f2); 
end; 
begin 
mm; 
movef1tof2; 
movef2tof1; 
readin; 
end. 
مستخدما بنية المصفوفات و المجموعات هء اكتب برنامج بلغة باسكال يقوم بإدخال عددين صحيحين موجبين ثم يطبع‎ 
عدد الأرقام المشتركة بين العددين مثال العدد الأول 62599 و العدد الثاني 6 فيطبع 1 و إذا كان العدد الأول 12343 و‎ 
. 2 العدد الثاني 5623 فيطبع‎ 
الحل:‎ 
program test; 
type 
mat=array[1..20]of integer; 
sets=set of 1..10; 
var s1,s2,s3:sets; 
t:mat; 
function count(x,y:integer):integer; 
var res,i:integer; 
begin 
i:=0;res:=0; 
while(x<>0)do 
begin 
i:=i+1; 
t[i]:=x mod 10; 
X:=xX div 10; 
end; 
s1:=]]; 
for res:=1 to i do 
s1:=s1+[t[res]]; 
i:=0; 
while(y<>0)do 
begin 
i:=i+1; 
t[i]:=y mod 10; 
y:=y div 10; 
end; 
s2:=]]; 
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,کم خلك لائ 


ما هو خرج البرامج التالية: 


(utمutpه)‏ الخرج 
;1,395 
,1,2,3,4,5 
,1,2,3,4 
ب1ا . 
None of the above‏ . 
ملاحظة: نلاحظ من خلال البرنامج أننا أعطينا 
المجموعة ٥٠٠۲ع‏ ثلاث قيم و هي ١و‏ ٣و‏ ° 
عندها يمكننا تخيل المجموعة بالنسق التالي في 
الذاكرة . 
1 2 3 4 5 
three 1)0) 1| 0 1‏ 
تدل الحجرة التي فيها 1 على أن دليل هذه الحجرة 
ينتمي إلى المجموعة عمع۲ط]. 


o goo 


الخرج: 
a=2,p1^=30,p2^=60‏ 
2^=0م,a=2,p1^=30‏ 
a=2,p1^=2,p2^=2‏ 
2^=0صa=30,p1^=30,p‏ 
2^=60مa=60,p1^=60,p e.‏ 
ملاحظة: المعامل @ في لغة باسكال يمكننا من 
التعامل مع العناوين حيث أن التعليمة (ه)@=:1م 
تجعل المتحول 1م يحوي عنوان المتحول ج في 
الذاكرة 
و يمكننا تخيل ذلك من خلال الرسم البياني التالي: 


o0 To» 


المهندس خالد ياسين الشيخ 


khaledyassinkh @gmail.com ٣ة علا ل‎ 


for res:=1 to i do 
s2:=s2+[t[res]]; 


S3:=51*s2; 
i:=0; 

res:=0; 
while(s3<>[])do 
begin 

if(i in s3)then 
begin 
res:=res+1; 
s3:=s3-]i[; 

end; 

i:=i+1; 

end; 
count:=res; 
end; 

var x,y:integer; 
begin 


readln(x,y); 
writeln(count(x,y)); 
readin; 

end. 


البرنامج 
program test;‏ 
type‏ 
five_digit=1..5;‏ 


three_digit=set of five_digit; 
var three:three_digit; i:integer; 
begin 
three:=[1,3,5]; 
i:=1; 

while(i in three)do 
begin 

write(i,','); 

i:=i+1; 

end; 

readin; 

end. 

program test; 
type 

p=^integer; 

var p1,p2:p; 
a:integer; 

begin 

d2 

p1:=@(a); 

p2:=p1; 

pم2^:=30;‎ p17:=60; 
write('a=',a); 
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,کم خلا لائ 


a 
J 
p 


حيث ٨1م‏ تجعل المتحول 1م أن يصل إلى 
محتوى العنوان الذي يحويه. 


خرج البرنامج هو: 
a. 1,2,3,4,5,6,‏ 
b. 6,5,4,3,2,1,‏ 
cC. 135,‏ 
d. 1,2,3,4,5,‏ 
الجواب الصحيح يختلف عما سبق(*) .ع 
ملاحظة: 


هتك التعامل مع المجموعات فی امال قان 
المتحول المعطيات من نوع مجموعة يجب أن 
يملك كحد أعلى 256 قيمة أي لا يمكن أن يكون 
أقل من 0 و لا أكثر من 255 و هذا يعني أننا لا 
نستطيع كتابة التعاريف التالي: 


set of integer; 
set of shortint; 
set of word; 
set of longint; 
set of shortint;: حیث اٹتعبير‎ 
لأن الأعداد المنتمية ل ١اه مء تقع ضمن‎ 
المجال من 128- إلى 127 . و هنا لدينا قيم أقل‎ 
من 0 و هذا غير مسموح.‎ 
الخرج:‎ 
إذا كان تم إدخال المحرف ۴ فإن البرنامج يقوم‎ 
عن‎ capital lettعۃ۲r بتحويل المحرف إلى‎ 
ںمcھse٥ طریق التابع‎ 
is Female 
syria,syria, 
welcome to syria 
press enter ... 
ملاحظة هامة:_لا يتم استخدام التعليمة هاهع‎ 
كثيرا في البرامج و لا ينصح بها برمجيا و يعتبرها‎ 
المبرمجون المحترفون نقصا في مقدرات المبرمج‎ 
لذلك فإنهم يتجنبون استخدامها لما تسبب من‎ 
إرباكات و تشعبات في البرنامج وتؤدي إلى‎ 
تذكر أن المبرمج المحترف و الواثق لا يستخدم‎ 
عبارة همع أبداً.‎ 
و الآن نعدل البرنامج بحيث لا يستخدم تعليمة‎ 
نهائيا ويقوم بنفس عمل البرنامج‎ ع٥‎ 
program test; 
var i:integer; ch:char; 
begin 
write ("what is your 
:<Femal,Male>(F,M)?'); 
readln(ch); 
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write(',p1^=',p17); 
writeln(',p2^=',p2^); 
readin; 
end. 


program test; 
type s=set of integer; 
var m:s; 
i:integer; 
begin 

m:=[]; 

for i:=1 to 6 do 
m:=m+[i]; 

i:=1; 
while(i<=6)do 
begin 

ifi in m then 
write(i,','); 
i:=i+1; 

end; 

readin; 

end. 


program test; 

var i:integer; ch:char; 

LABEL 

jump1,next,stop; 

begin 

jump1: 

write('what is your :<Femal,Male>(F,M)?'); 
readln(ch); 

ch:=upcase(ch); 

if not((ch='F')Jor(ch='M'))then 
goto jump1; 

if(ch='M')then 

writeln('is Male') 

else 

writeln('is Female'); 

i:=1; 


i:=i+1; 
if(i>3)then 
goto stop; 
write('syria,'); 
goto next; 
stop: 
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ch:=upcase(ch); 

if not((ch='F')Jor(ch='M'))then 
if(ch='M')then 

writeln('is Male') 

else 

writeln('is Famle'); 

i:=1; 

while(i<3)do 

begin 

write('syria,'); 

i:=i+1; 

end; 

writeln; 

writeln('welcome to syria'); 
write('press enter ...'); 
readin; 

end. 


a. 1,2,3,45, 


b. 5,4,3,2,1, 

Ce 235, 

d. 1,2,4,5,3, 

e. None of the above 
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writeln; 
writeln('welcome to syria'); 
write('press enter ...'); 
readin; 
end. 
readin; 
end. 


program test; 
const n=5; 

type index=1..n; 
var mat:array[index] of integer; 
procedure p1; 
var i:integer; 
begin 

=1: 
while(i<=n)do 
begin 
write(mat[i],','); 
i:=i+1; 

end; 

writeln; 

end; 

procedure p2; 
var i,t:integer; 


begin 

for i:=1 to n div 2 do 
begin 

t:=mat[i]; 


mat[i]:=mat[n-i+1]; 
mat[n-i+1]:=t; 

end; 

end; 

var count:integer; 
begin 

for count:=1 to n do 
mat[count]:=count; 
p2; 

p1; 

readin; 
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کم خلا لائ 


الخرج: 
hi omar How are you?‏ 
hi om‏ 
Omar‏ . 
are‏ 
are you‏ 


no@a go 


الخرج: 
omar ali How are you?‏ 
omar How are you?‏ 
ali How are you?‏ 
e you?‏ 
None of the above‏ 


0O0 Tow 


: حدد رقم السطر الذي يحوي تعليمات خاطئة‎ 
a. 2 
b. 5 
c. 9 
d. 10and9 and 2 
e. None of the above 
خرج البرنامج هو:‎ 


a. 1,2,3,4,5, 
FALSE 

TRUE 

b. 5,4,3,2,1 
True 

FALSE 

ê JOSS AS, 
FALSE 

IRUE 

d. 10,5,3,2,9, 
TRUE 

FALSE 

e. None of the above 
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end. 


Var 
S : String; 


Begin 

S := 'hi omar How are you?'; 
S := Copy(S, 4, 4); 

Write(S); 

readin; 

End. 

program test; 

var s:string; 

begin 


S := 'omar ali How are you?'; 
Delete(S, 5, 4); 

Write(S); 

readin; 

end. 


2 


program test; 

const mat:array[1..5] of 
integer=(10,5,3,2,9); 
var i:integer; 

begin 

{hi} 

for i:=1 to 5 do 
write(mat[i],','); 
writeln; 

. writeln(not(mat[5]>mat[2])); 
10. writeln(mat[5]>mat[2]); 
11. readln; 

12. end. 
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س دودمم 
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لدينا ملف نصي ٤.»‏ يحوي مثلا ما يلي: 


Syria 
Welcome to syria 
Syria Arabic 


Damascus 
hi khaled hi 


-١‏ تابع count cha‏ تقوم بإعادة عدد 
أحرف الملف 

۲- تابع "امه يعید عدد أسطر الملف 

۳- إجرائية ٣زم‏ لطباعة محتويات لملف 
على شاشة الحاسب 

E:‏ تابع يعيد عدد الكلمات في الملف باعتبار 
الفصل بين كلمة و أخرى هو فراغ واحد 

-٥‏ إجرائية تقوم بحذف كلمة ام أينما 
وردت ضمن الملف. 


اكتب برنامج بلغة باسكال القياسية يقوم بتخزين بيانات طلاب السنة الأولى في كلية الهندسة المعلوماتية بجامعة دمشق 
حيث يعرف كل طالب من خلال رقم ذاتي ۲٥ط‏ ںہ (لا يتكرر) و اسم ٠ص‏ هم بالإضافة إلى علامات المواد التالية: 
الرياضيات غج" 
البرمجة١‏ 1عه۲م 
الإنكليزي "ع 
العربي ٣ج‏ 
و العلامة النهائية من 100 و جميع العلامات صحيحة. 
ملاحظة يجب معالجة حالة تكرار إدخال رقم طالب موجود . 
والمطلوب: 
-١‏ اقترح بنية معطيات مناسبة لتخزين بيانات الطالب. 
۲- إجرائية 4هء لقراءة البيانات الخاصة بكل طالب. 
۳- إجرائية ۲٣ل‏ ںاءا۲مء تقوم بترتيب عناصر بيانات الطلاب تنازليا حسب المعدل. 
-٤‏ إجرائية "عمك ں†ء†مامم لطباعة اسم الطالب و رقمه و معدله. 


لدينا بيانات تتضمن معلومات عن موظفي كلية الهندسة المعلوماتية بجامعة دمشق تتضمن بيانات الموظف المعلومات 
التالية: 
رقم ذاتي ۲٥ط‏ ںم علما أن رقم الموظف يعطى بشكل تسلسلي حصرآً(أي الموظف الذي يتم إدخال بياناته أولا يأخذ 
الرقم 1 و الموظف الثاني الرقم 2 و هكذا....) 
الاسم الأوJ first_name‏ 
الكنية مصهم_اءa|‏ 
تاريخ الميلاد و يتضمن اليوم ك و الشهر " و السنة ر 
الراتب راء 
و المطلوب كتابة برنامج بلغة البرمجة اهعءهم٥:‏ 
-١‏ اقترح بينة معطيات مناسبة لتخزين بيانات الموظف. 
-١‏ تابع لقراءة بيانات الموظف. 
۳- إجرائية تقوم بترتيب بيانات الموظفين ترتيبا تنازليا حسب الراتب. 
-٤‏ إجرائية لطباعة بيانات الموظفين على شاشة الحاسب. 
-٥‏ عدل الطلب الثاني بحيث تصبح التابع إجرائية أي تابع لا يعيد قيمة 
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,کم خلك لائ 


بعد التعديل على شاشة الحاسب. 


المهندس خالد ياسين الشيخ 


المطلوب كتابة برنامج بلغة باسكال يقوم ب: 
استبدال عبارة ءأطه٣ه‏ بعبارة ذ٣‏ رء أينما وردت 


حل لج ق٣‏ 


while(c in ['a'..'z','A'..'Z','0'..'9'])do 


khaledyassinkh @gmail.com 


program test; 

var f1,f2:text; 
c:char; s:string; 
procedure mprint; 
begin 
assign(f1,'c:\f1.txt'); 
reset(f1); 
assign(f2,'c:\f2.txt'); 
rewrite(f2); 
while(not eof(f1))do 
begin 

5 

while(not eoln(f1))do 
begin 

read(f1,c); 


begin 

Si=s+C; 

read(f1,c); 

end; 
if(s='arabic')then 
s:='syria'; 

write(s,C); 
write(f2,s,C); 

8 

end; 

readln(f1); 

writeln; 

writeln (f2); 

end; 

close(f1); 

close(f2); 

end; 

procedure movetof1; 
begin 
assign(f1,'c:\f1.txt'); 
assign(f2,'c:\f2.txt'); 
reset(f2); 
rewrite(f1); 
while(not eof(f2))do 
begin 

while(not eoln(f2))do 
begin 

read(f2,c); 
write(f1,c); 

end; 

readln(f2); 
writeln(f1); 

end; 

close(f1); 

close(f2); 

end; 

begin 

mprint; 

movetof1; 

readin; 

end. 
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اکتب برنامج يعمل من خلال سجل على إدخال بيانات program test;‏ 
تتعلق ب م شخص و يحوي السجل الاسم الأول const n=20;‏ 
عمmهمf‏ و الاسم الأخير م٣‏ هم| و العمر مع . type‏ 
و تخزين هذه البيانات في مصفوفة اص ثم يرتب هذه pers=record‏ 
البيانات ترتیبا تصاعديا ۴ في حال تساوي الاسم الأول ame SRE:‏ 
يفحص الكنية. ثم يقوم البرنامج بطباعة البيانات قبل e‏ 
وبعد الفرز. e‏ 


end; 

matrix=array[1..n] of pers; 

file2=file of pers; 

procedure insertdata(var mat:matrix; 
n:integer); 

var i:integer; 

begin 

for i:=1 to n do 

begin 

with mat[i] do 

begin 

readln(fname); 

readln(Iname); 

readln(age); 

end; 

end; 

end; 

procedure swap(var mat:matrix; 
i,j:integer); 

var t:pers; 

begin 

t:=mat[i]; 

mat[i]:=mat[j]; 

mat[j]:=t; 

end; 

procedure sortdata(var 
mat:matrix;n:integer); 

var i,j:integer; 

begin 

for i:=1 to n-1 do 

for j:=1 to n-1 do 
if(mat([j].fname>mat[j+1].fname)then 
swap(mat,j,j+1) 

else 
if(mat([j].fname=mat([j].fname)then 
begin 
if(mat([j].Iname>mat([j+1].lIname)then 
swap(mat,j,j+1); 

end; 

end; 

procedure print(var 
mat:matrix;n:integer); 

var i:integer; 

begin 

for i:=1 to n do 
writeln(mat([i].fname,' ',mat[i].lIname,' 
'„mat[i].age); 

end; 

procedure mov(var f1:file2;mat:matrix; 
n:integer); 


نقل عناصر المصفوفة إلى ملف ثنائي.و من ثم طباعة 
عناصر الملف الثنائي في ملف نصي و على الشاشة. 
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var 
t:pers; 

i:integer; 

begin 
assign(f1,'c:\f.bin'); 
rewrite(f1); 

i:=1; 

while(i<=n)do 

begin 

t:=mat[i]; 

write(f1,t); 

i:=i+1; 

end; 

close(f1); 

end; 

var nn:integer; mat1:matrix; 
f1:file2; 

procedure p1; 

var t:pers; f:text; 

begin 
assign(f1,'c:\f.bin'); 
assign(f,'c:\file.txt'); 
reset(f1); 

rewrite(f); 

while(not eof(f1))do 
begin 

read(f1,t); 
writeln(t.fname,' ',t.Iname,' ',t.age); 
writeln(f,t.fname,' ',t.Iname,' ',t.age); 
end; 

close(f1); 

close(f); 

end; 

begin 

readln(nn); 
insertdata(mat1,nn); 
print(mat1,nn); 
sortdata(mat1,nn); 
Writeln (1 -======--=-==-==-- '); 
print(mat1,nn); 
mov(f1,mat1,nn); 
Writeln (1 -===----=-==----- '); 
p1; 

readin; 

end. 


اكتب برنامج بلغة باسكال يقوم بحذف كلمة م أينما program test;‏ 
وردت صمن ملف نصي ×.1] و يراد إعادة تشكيل var f1,f2:text;‏ 
هذا الملف بدون كلمة أط . c:char; s:string; ok:boolean;‏ 
مثال: ليكن لدينا الملف ;»۴1.1 كمايلي: procedure mprint;‏ 
begin‏ 
assign(f1,'c:\f1.txt'); hi‏ 

reset(f1); hi khaled 
assign(f2,'c:\f2.txt'); hi how hi are hi you 
rewrite (f2); hi 

while(not eof(f1))do 
begin 
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يصبح محتويات الملف بعد تنفيذ البرنامج المطلوب كما يلي: ;اك 
ok:=false;‏ 

while(not eoln(f1))do Khaled 

begin how are you 
read(f1,c); 

while(true)do 

begin 

Si=s+C; 

أكثب إجراء فناب لظاعة محتونات الملف بف الثكال if( eoln(f1))then‏ 
على الشاشة. break;‏ 
read(f1,c);‏ 

if( (c=' ')) then 

break; 

end; 

if(s<>'hi')then 

begin 

ok:=true; 

و 

write(f2,s,C); 

end; 

g2 

end; 

readln(f1); 

writeln; 

if(ok)then 

writeln (f2); 

end; 

close(f1); 

close(f2); 

end; 

procedure movetof1; 

begin 


assign(f1,'c:\f1.txt'); 
assign(f2,'c:\f2.txt'); 
reset(f2); 
rewrite(f1); 
while(not eof(f2))do 
begin 

while(not eoln(f2))do 
begin 

read(f2,c); 
write(f1,c); 

write(c); 

end; 

readln(f2); 
writeln(f1); 

writeln; 

end; 

close(f1); 

close(f2); 

end; 


begin 
mprint; 
movetof1; 
readin; 
end. 
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کم خلك لائ 


يحوي بيانات موظف على الشكل التالي: 


مثال: ليكن محتويات الملف »۴1.1 كما يلي: 


الشاشة الحاسب: 


المهندس خالد ياسين الشيخ 


حل لج ق٣‏ 


لدينا ملف نصي ».۴1 يحوي بيانات موظفي كلية 
الونة الت ما امع دمشق خت گل سط 


رقم الموظف(لا يتكرر) و الاسم و الراتب علما أن 
الفاصل بين الاسم و الرقم هو حرف واحد حصراً 
المطلوب نقل هذه البيانات من الملف النصي ».۴1 إلى 
بنية معطيات سلسلة خطية باتجاه واحد و من ثم فرز 
عناصر السلسلة فرزا تنازليا حسب رقم الموظف. 


1 khaled yassin 2000sp 
8 omra ali 9000sp 


2 ihab alqassim 1500sp 


يراد طباعة محتويات السلسلة الخطية كما يلي على 


8 omra ali 9000sp 
2 ihab alqassim 1500sp 
1 khaled yassin 2000sp 


ملاحظة هامة: هنا لا داعي لوجود حقل معطیات 
راء لأن الحقل المعطيات ۳٠‏ هم يغني عن ذلك . 


program test; 

type 

emp=^info; 

info=record 

number:integer; 

name:string; 

next:emp; 

end; 

ftext=file of info; 

var f:text; t:info;jc:char; i:integer; 
procedure movetoseries(var f1:text; 
var head:emp); 

var temp,pnext,prev:emp; c:char; 
begin 

assign(f1,'c:\f1.txt'); 

reset(f1); 

while(not eof(f1))do 

begin 

read(f1,t.number); 

read(f1,c); 

readln(f1,t.name); 

new(temp); 
temp^.number:=t.number; 
temp^.name:=t.name; 
temp^.next:=nil; 

if(head=nil)then 

head:=temp 

else 
if(head^.number<temp^.number)then 
begin 

temp^.next:=head; 

head:=temp; 

end 

else 

begin 

pnext:=head; 

prev:=pnext; 
while((pnext<>nil)and 
(pnext^.number>temp^.number))do 


begin 

prev:=pnext; 
pnext:=pnext^.next; 
end; 


prev^.next:=temp; 
temp^.next:=pnext; 
end; 

end; 

close(f1); 

end; 

procedure print(p:emp); 
begin 

while(p<>nil)do 

begin 
writeln(p^.number,' ',p^.name); 
p:=p^.next; 

end; 

end; 
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الم ہم. خلا الشجح عا لج ة٣ khaledyassinkh @gmail.com‏ 


var head:emp; 

begin 

head:=nil; 
movetoseries(f,head); 
print(head); 

readin; 

end. 


ناديت باسمك يا إلهي ضارعا إن لم تجبني فمن يجيب بكائي 


أنت الكريم فلا تدعني تائها فلقد عييت من البعمادد النائي 
مالي سوى أعتاب جودك موئلا فلئن رددت فمن سواك رجائي 


7 حوه ۷١‏ ك ةد 
E‏ خد و اتاک 
اکھد 
ای قوعت اود 
in‏ 


أحفظ لسانك أيها الإنسانْ لا يلدغنك أنه ثعبان 
كم في المقابر من قتيل لسانه كانت تهاب لقاءه الشجعان 


دع الایام تفعل ما تشَاء وَطب تسا إا حكم القضاءٌ 
ولا تَجْرَع إِحَادثة الليالي قما لِحَوّادث الذنيا بقاءٌ (من شعر الإمام الشافعي رحمه الله) 


إن أكبر معركة يخوضها الإنسان هى المعركة التي يغير فيها بعض عاداته و سلوكياته 
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